home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 22 / Amiga Format AFCD22 (Jan 1998, Issue 106).iso / -readerstuff- / d_keletsekis / tools / palette.gc < prev    next >
Text File  |  1997-10-03  |  7KB  |  219 lines
  1. G4C
  2.  
  3. ; Palette.gc by dck/J.Collett
  4.  
  5. ; A full palette gui with many capabilities
  6. ; Press CONTROL-J to make it jump screens
  7.  
  8. winbig -1 -1 235 120 'Palette'
  9. wintype 11110001
  10.  
  11. box 0 0 0 0 out icondrop
  12.  
  13. xonload
  14. guiopen palette.gc
  15.  
  16. xonopen
  17. info palette palette.gc/5        ; get info on *our* platte
  18. setvar type 'update'
  19. gosub palette.gc update                 ; Subroutine
  20.  
  21. xonRMB        ; on rmb we update to the color under mouse position
  22. update palette.gc 5 $$mouse.color
  23. gosub palette.gc update        ; did not choose the color by clicking it
  24.  
  25. xonclose
  26. ;  ---- If Ram:Spr was created, delete it
  27. ifexists FILE Ram:Spr.rexx
  28.    delete Ram:Spr.rexx
  29. endif
  30. guiquit palette.gc
  31.  
  32. xpalette 10 5 225 30               ; This is the visible palette
  33. gadid 5
  34. gosub palette.gc $type
  35.  
  36. xHSlider 40 40 160 12 R pal.r 0 15 0 %2ld
  37. ;gadhelp "Set the intensity of the RED colour."
  38. setcolor palette.gc $$color.num $pal.r $pal.g $pal.b
  39. gadid 1
  40.  
  41. xHSlider 40 52 160 12 G pal.g 0 15 0 %2ld
  42. ;gadhelp "Set the intensity of the GREEN colour."
  43. setcolor palette.gc $$color.num $pal.r $pal.g $pal.b
  44. gadid 2
  45.  
  46. xHSlider 40 64 160 12 B pal.b 0 15 0 %2ld
  47. ;gadhelp "Set the intensity of the BLUE colour."
  48. setcolor palette.gc $$color.num $pal.r $pal.g $pal.b
  49. gadid 3
  50.  
  51.  
  52. ; --- routine to update sliders & get variables
  53.  
  54. xRoutine update
  55. pal.r = $$color.r     ; get new values   Three colour values, the
  56.                       ; colour number, and the total number of colours.
  57. pal.g = $$color.g
  58. pal.b = $$color.b
  59. pal.n = $$color.num
  60. pal.t = $$color.total
  61. pal.or = $pal.r       ; store values for undo slider changes
  62. pal.og = $pal.g       ; original rgb values
  63. pal.ob = $pal.b
  64. update palette.gc 1 $pal.r    ; Update gads 1, 2, 3
  65. update palette.gc 2 $pal.g
  66. update palette.gc 3 $pal.b
  67. setwintitle palette.gc 'Palette color $pal.n of $pal.t'
  68.  
  69.  
  70. ; -----------> buttons to save/load etc palettes (saved as guis)
  71.  
  72. xbutton 10 85 70 14 Undo     ; undo last changes
  73. setcolor palette.gc $$color.num $pal.or $pal.og $pal.ob
  74. gosub palette.gc update
  75.  
  76.  
  77. ; ---- Load a previously saved palette (i.e. a normal GUI with setcolors)
  78. ; ---- We *must* set the variable $pal.gui to the name of our gui
  79.  
  80. xbutton  80 85 70 14 Load..
  81. ;gadhelp "Load a previously saved palette setting gui."
  82. pal.file = ''
  83. ReqFile -1 -1 300 200 'Load Palette:' LOAD pal.file 'GUIs:tools/palette'
  84. if $pal.file = ''
  85.    stop
  86. endif
  87. *pal.gui = palette.gc        ; set pal.gui as a GLOBAL variable (old)
  88. guiload $pal.file palette.gc    ; load the gui (new - variable passed)
  89. delvar *pal.gui            ; delete pal.gui as we don't need it
  90. update palette.gc 5 1        ; go back to color No 1
  91. info palette palette.gc/5    ; get info on palette
  92. gosub palette.gc update        ; redraw the sliders etc
  93.  
  94.  
  95. ; ---- saving : make a loop and write a gui to set all colors
  96. ;      variable pal.gui must (when loading) contain the name of the
  97. ;      gui whose screen colors will be changed.
  98.  
  99. xbutton  150 85 70 14 Save..
  100. ;gadhelp "Save the palette as gui."
  101. pal.file = ''
  102. ReqFile -1 -1 300 200 'Save Palette:' SAVE pal.file ''
  103. if $pal.file = ''
  104.    stop
  105. endif
  106. guiwindow palette.gc wait
  107. setwintitle palette.gc 'Saving Palette...'
  108. info palette palette.gc/5       ; make sure we're talcking about *our* palette
  109. setvar .palette 'G4C\n\n;Palette\n\nxOnLoad gui\n'
  110. pal.count = 0
  111. while $pal.count < $pal.t
  112.     update palette.gc 5 $pal.count  ; update the palette to next color
  113.     append env:.palette 'setcolor \$gui $pal.count $$color.r $$color.g $$color.b\n'
  114.     counter pal.count inc 1 
  115. endwhile
  116. extract pal.file file pal.filename
  117. append env:.palette 'guiquit $pal.filename\n'
  118. copy env:.palette $pal.file
  119. delete env:.palette
  120. guiwindow palette.gc resume
  121. update palette.gc 5 1
  122. info palette palette.gc/5
  123. gosub palette.gc update
  124.  
  125. ; ---- JC's additions below this line : Copy, Exchange, Spread
  126.  
  127. xbutton  10 100 70 14 Copy
  128. setvar type 'copy'
  129.  
  130. xbutton  80 100 70 14 Exchange
  131. setvar type 'exchange'
  132.  
  133. xbutton  150 100 70 14 Spread
  134. setvar type 'spread'
  135.  
  136. ; --- routine to copy values
  137.  
  138. xRoutine copy
  139. pal.on = $pal.n       ; Store existing colour number
  140. pal.r = $$color.r     ; get new values  
  141. pal.g = $$color.g
  142. pal.b = $$color.b
  143. pal.n = $$color.num
  144. ;Set new colour to old values
  145. setcolor palette.gc $pal.n  $pal.or $pal.og $pal.ob
  146. setvar type 'update'             ; Reset routine flag
  147. ; Update window title
  148. setwintitle palette.gc 'Copied color $pal.on to $pal.n'
  149. update palette.gc 5 $pal.n
  150. gosub palette.gc update
  151.  
  152. ; --- routine to exchange values
  153.  
  154. xRoutine exchange
  155. pal.on = $pal.n       ; Store existing colour number
  156. pal.r = $$color.r     ; get new values  
  157. pal.g = $$color.g
  158. pal.b = $$color.b
  159. pal.n = $$color.num
  160. ;Set each colour to other values
  161. setcolor palette.gc $pal.n  $pal.or $pal.og $pal.ob
  162. setcolor palette.gc $pal.on  $pal.r $pal.g $pal.b
  163. setvar type 'update'             ; Reset routine flag
  164. ; Update window title
  165. setwintitle palette.gc 'Exchanged colors $pal.on and $pal.n'
  166. update palette.gc 5 $pal.n
  167. gosub palette.gc update
  168.  
  169. ; --- routine to spread values
  170.  
  171. xRoutine spread
  172. update palette.gc 5 $$color.num
  173. setvar CStore "$pal.n "
  174. appvar CStore "$$color.num "
  175. appvar CStore "$pal.or "
  176. appvar CStore "$pal.og "
  177. appvar CStore "$pal.ob "
  178. appvar CStore "$$color.r " 
  179. appvar CStore "$$color.g "
  180. appvar CStore "$$color.b"
  181. ifexists FILE Ram:Spr.rexx
  182.     ; nop
  183. else
  184.     gosub Palette.gc MakeRexx
  185.     rename env:.Spr Ram:Spr.rexx
  186. endif
  187. run 'sys:rexxc/rx Ram:Spr.rexx $CStore'
  188. setvar type 'update'             ; Reset routine flag
  189. gosub palette.gc update
  190.  
  191. ; ---- Routine to create an ARexx program to do the spreading.
  192.  
  193. xroutine MakeRexx
  194. setvar .Spr "/* */\n"
  195. append Env:.Spr "parse arg col1 col2 r1 g1 b1 r2 g2 b2 \n"
  196. append Env:.Spr "if col1 > col2 then do\n"
  197. append Env:.Spr "   n = col1 ; col1 = col2 ; col2 = n\n" 
  198. append Env:.Spr "   rn = r1 ; r1 = r2 ; r2 = rn\n" 
  199. append Env:.Spr "   gn = g1 ; g1 = g2 ; g2 = gn\n" 
  200. append Env:.Spr "   bn = b1 ; b1 = b2 ; b2 = bn ; end\n"
  201. append Env:.Spr "dif = col2 - col1 - 1\n"
  202. append Env:.Spr "rds = max(r1,r2) - min(r1,r2) - 1\n"
  203. append Env:.Spr "gds = max(g1,g2) - min(g1,g2) - 1\n"
  204. append Env:.Spr "bds = max(b1,b2) - min(b1,b2) - 1\n"
  205. append Env:.Spr "dr = sign(r2 - r1) ; dg = sign(g2 - g1)\n"
  206. append Env:.Spr "db = sign(b2 - b1)\n"
  207. append Env:.Spr "rbit = rds / dif * dr ; gbit = gds / dif * dg\n"
  208. append Env:.Spr "bbit = bds / dif * db\n"
  209. append Env:.Spr "do st = 1 to dif\n"
  210. append Env:.Spr "   r = r1 + trunc(st * rbit)\n"
  211. append Env:.Spr "   g = g1 + trunc(st * gbit)\n"
  212. append Env:.Spr "   b = b1 + trunc(st * bbit)\n"
  213. append Env:.Spr "   msg = col1 + st || ' ' r || ' ' || g || ' ' b\n"
  214. append Env:.Spr "   address 'Gui4Cli'\n"
  215. append Env:.Spr "   'SetColor Palette.gc ' msg\n"
  216. append Env:.Spr "   address\n"
  217. append Env:.Spr "   end\n"
  218. append Env:.Spr "exit\n"
  219.